home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 8 / FM Towns Free Software Collection 8.iso / fb386 / eiyoukei / chori7.bas < prev    next >
BASIC Source File  |  1994-06-01  |  7KB  |  172 lines
  1. 10 'SAVE "CHORI7.BAS",A
  2. 20 '調理名ー食品名入力
  3. 30 '          V2.0                  91.05.04
  4. 35 COLOR 7:C150=300
  5. 40 OPEN "(128)SEIBUN.DAT" AS #1
  6. 50 FIELD #1,0   AS DAMMY$,4  AS コード$
  7. 60 FIELD #1,4   AS DAMMY$,16 AS 食品群$
  8. 70 FIELD #1,20  AS DAMMY$,32 AS 成分表食品名$
  9. 80 OPEN "(72)CYOURI.DAT" AS #2
  10. 90 FIELD #2,0   AS DAMMY$,4  AS コード$,2 AS DLT$
  11. 100 FIELD #2,4   AS DAMMY$,32 AS 調理名$
  12. 110 FIELD #2,36  AS DAMMY$,32 AS 調理表食品名$
  13. 120 FIELD #2,68  AS DAMMY$,4  AS CHORISYOKUHINJURYO$
  14. 130 DIM SYOKUHINMEI$(C150)
  15. 140 DIM CHORIMEI$(C150),CHOINDX(C150)
  16. 150 DIM CHORISYOKUHINMEI$(C150),CHORISYOKUHINJURYO(C150)
  17. 160 KEY 10,"終了"+CHR$(&H0D)
  18. 170 KEY 1,"登録"
  19. 180 KEY 2,"取消"
  20. 181 KEY 3,"クリア"'CHR$(&H09)
  21. 182 KEY 4,"名前変"'CHR$(&H0B)
  22. 183 KEY 5,"画面変"
  23. 184 KEY 6,"確定"'CHR$(&H1B)
  24. 190 CLS:C15=15:CONSOLE 4,C15+1,1
  25. 200 CLS:PRINT 
  26. 210 TOROKUSU=LOF(1):PRINT  "日本食品成分表は;"TOROKUSU;"件登録済です。"
  27. 220 ST=TOROKUSU
  28. 230 'PRINT "何かキーを押して下さい。":GOSUB *INKEY
  29. 240 IF TOROKUSU=0 THEN 310
  30. 250 FOR I=1 TO TOROKUSU
  31. 260 GET #1,I
  32. 270 SYOKUHINMEI$(I)=成分表食品名$
  33. 280 'PRINT  USING "&                                      &";成分表食品名$;
  34. 290 NEXT I:PRINT:CLOSE #1 
  35. 300 'PRINT "何かキーを押して下さい。":GOSUB *INKEY
  36. 310 LOCATE 0,4:CLS 1:TOROKUSU=LOF(2)
  37. 320 J=0:IF TOROKUSU=0 THEN 410
  38. 330 OCHORIMEI$=""
  39. 340 FOR I=1 TO TOROKUSU
  40. 350 GET #2,I
  41. 360 IF OCHORIMEI$=調理名$ THEN 390 ELSE J=J+1
  42. 370 CHORIMEI$(J)=調理名$:CHOINDX(J)=I':PRINT J;CHORIMEI$(J);CHOINDX(J);
  43. 380 PRINT  USING "&                                      &";調理名$;
  44. 390 OCHORIMEI$=調理名$
  45. 400 NEXT I:PRINT 
  46. 410 RT=J:PRINT  "調理名は;"J;"件登録済です。"
  47. 420 PRINT "何かキーを押して下さい。",:GOSUB *INKEY
  48. 430 CLS
  49. 440 LOCATE 0,0
  50. 445 FOR I=1 TO ST:CHORISYOKUHINJURYO(I)=0:NEXT I
  51. 450 INPUT "　　　調理名   　     ",CHORIMEI$
  52. 460 IF CHORIMEI$="終了" THEN CLOSE:RUN "EIYOUKEI.BAS":END
  53. 461 IF CHORIMEI$="" THEN 310
  54. 465 CHORIMEI$=CHORIMEI$+SPACE$(32-LEN(CHORIMEI$))
  55. 470 N=SEARCH(CHORIMEI$,CHORIMEI$):'LOCATE 0,22:PRINT N
  56. 480 IF N>0  THEN GOSUB 1180:IF KSW=1 THEN KSW=0:GOTO 500 ELSE 500  '更新
  57. 490 IF N=-1 THEN GOSUB 510:IF KSW=1 THEN KSW=0:GOTO 500 ELSE 500    '追加
  58. 500 GOTO 430
  59. 510 'データの追加
  60. 514 CLS 3:LOCATE 0,22:PRINT "データの追加";
  61. 515 LOCATE 0,23:PRINT "データの確定 ＥＳＣ　 調理名取消　ＰＦ３　　　　　　　　　　　　　　";
  62. 520 OI2=1:J=1:X=0:Y=4:LOCATE X,Y
  63. 530 FOR I=1 TO C15*2:II=I-1
  64. 540 LOCATE X+40*(II \ C15),Y+II MOD C15
  65. 550 P=((J-1)\(C15*2))*C15*2
  66. 560 IF P+I<=ST THEN PRINT USING  "###  ";P+I;:PRINT  SYOKUHINMEI$(P+I);
  67. 570 IF CHORISYOKUHINJURYO(P+I) = 0 THEN 600
  68. 580 LOCATE X+40*(II \ C15)+28,Y+II MOD C15
  69. 590 IF P+I<=ST THEN PRINT USING  "#####.###";CHORISYOKUHINJURYO(P+I);
  70. 600 NEXT I
  71. 610 GOSUB 640:IF KSW=1 THEN RETURN ELSE GOTO 530
  72. 620 STOP
  73. 630 '*************************************************
  74. 640 XX=0:YY=0:P=((I-1) \ (2*C15))+1
  75. 650 JJ=J-1:P=J:OXX=XX:OYY=YY
  76. 660 XX=X+40*((JJ \ C15) MOD 2):YY=Y+JJ MOD C15
  77. 670 IF NOT(OXX=0 AND OYY=0) THEN LOCATE OXX,OYY:PRINT USING "###  ";OI2;
  78. 680 LOCATE XX,YY:COLOR 2:PRINT USING "###★";J;:COLOR 7:OI2=J
  79. 690 GOSUB *INKEY
  80. 700 IF X$=CHR$(&H1F) THEN J=J+1
  81. 710 IF X$=CHR$(&H1E) THEN J=J-1
  82. 720 IF X$=CHR$(&H1D) THEN J=J-C15
  83. 730 IF X$=CHR$(&H1C) THEN J=J+C15
  84. 740 IF (X$>=CHR$(&H30) AND X$=<CHR$(&H39)) OR X$=CHR$(&H2E) THEN GOSUB 820:GOTO 790
  85. 750 IF X$=CHR$(&H1B) OR X$="確定" THEN GOSUB 910:IF KSW=1 THEN RETURN ELSE J=1:CLS 1:RETURN
  86. 751 IF X$=CHR$(&H09) OR X$="クリア" THEN KSW=1:RETURN 
  87. 755 IF X$=CHR$(&H0B) OR X$="名前変" THEN GOSUB 2440:GOTO 690 
  88. 760 IF J<1 THEN J=ST
  89. 770 IF J>ST THEN J=1
  90. 780 IF (J-1)\(C15*2)<>(P-1)\(C15*2) THEN CLS 1:RETURN
  91. 790 GOTO 650
  92. 800 '***********************************************
  93. 810 X$=INKEY$:IF X$="" THEN 810
  94. 811 X2$=INKEY$:IF X2$="" OR X2$<CHR$(&H20) THEN RETURN
  95. 812 X$=X$+X2$:GOTO 811
  96. 820 '************************************************
  97. 830 WW$="":XXW=XX
  98. 840 LOCATE XXW+28,YY
  99. 850 IF (X$>=CHR$(&H30) AND X$=<CHR$(&H39)) OR X$=CHR$(&H2E) THEN WW$=WW$+X$:PRINT X$;:XXW=XXW+1
  100. 860 GOSUB *INKEY:LOCATE 0,23
  101. 870 IF X$=>CHR$(&H1C) AND X$=<CHR$(&H1F) THEN 880 ELSE 840
  102. 880 CHORISYOKUHINJURYO(J)=VAL(WW$)
  103. 890 LOCATE XX+28,YY:PRINT USING "#####.###";CHORISYOKUHINJURYO(J);
  104. 900 RETURN 700
  105. 910 '再表示登録 
  106. 920 II=0:CLS 1:X=0:Y=4
  107. 930 FOR J=1 TO ST
  108. 940 IF CHORISYOKUHINJURYO(J) = 0 THEN 1010
  109. 950 LOCATE X+40*((II \ C15) MOD 2),Y+II MOD C15
  110. 960 PRINT USING  "###  ";J;:PRINT  SYOKUHINMEI$(J);
  111. 970 LOCATE X+40*((II \ C15)MOD 2)+28,Y+II MOD C15
  112. 980 PRINT USING  "#####.###";CHORISYOKUHINJURYO(J);
  113. 990 II=II+1
  114. 1000 IF II MOD C15*2 = 0 THEN LOCATE 0,21:PRINT "なにかキーを押してください。";:GOSUB *INKEY:CLS 1
  115. 1005 'IF II MOD C15*2 = 0 THEN LOCATE 0,23:INPUT "なにかキーを押してください。",X$:CLS 1
  116. 1010 NEXT J
  117. 1020 LOCATE 0,23:PRINT "登録 ＰＦ１　取消　ＰＦ２　名前変更　ＰＦ４　　入力画面　ＥＳＣ";:GOSUB *INKEY
  118. 1025 IF X$=CHR$(&H0B) OR X$="名前変" THEN GOSUB 2440:GOTO 1020
  119. 1030 IF X$="登録" THEN GOSUB 1050:KSW=1 ELSE KSW=0
  120. 1035 LOCATE 0,23:PRINT "データの確定 ＥＳＣ　 調理名取消　ＰＦ３　　　　　　　　　　　　　　";
  121. 1040 RETURN
  122. 1050 '登録書き込み
  123. 1060 TRSU=LOF(2):L=1
  124. 1070 FOR J=1 TO ST
  125. 1080 IF CHORISYOKUHINJURYO(J) = 0 THEN 1140
  126. 1090 LSET 調理名$=CHORIMEI$
  127. 1100 LSET 調理表食品名$=SYOKUHINMEI$(J)
  128. 1110 LSET CHORISYOKUHINJURYO$=MKS$(CHORISYOKUHINJURYO(J))
  129. 1120 CHORISYOKUHINJURYO(J)=0
  130. 1130 PUT #2,TRSU+L:L=L+1
  131. 1140 NEXT J
  132. 1150 RT=RT+1:CHORIMEI$(RT)=CHORIMEI$:CHOINDX(RT)=TRSU+1
  133. 1160 RETURN
  134. 1170 '**************************************************
  135. 1180 'データの更新
  136. 1185 CLS 3:LOCATE 0,22:PRINT "データの更新";
  137. 1187 LOCATE 0,23:PRINT "データの確定 ＥＳＣ　 調理名取消　ＰＦ３　名前変更　ＰＦ４";
  138. 1190 FOR I=1 TO ST:CHORISYOKUHINJURYO(I)=0:NEXT I
  139. 1195 NI=CHOINDX(N):LNI=LOF(2):CHORIMEI$(N)="**"+LEFT$(CHORIMEI$(N),30)
  140. 1200 IF NI>LNI THEN 1250 ELSE GET #2,NI
  141. 1201 'LOCATE 0,20:PRINT 調理名$;調理表食品名$;CVS(CHORISYOKUHINJURYO$)
  142. 1210 IF 調理名$<>CHORIMEI$ THEN 1250
  143. 1215 LSET 調理名$="**"+LEFT$(調理名$,30):PUT #2,NI:NI=NI+1
  144. 1220 M=SEARCH(SYOKUHINMEI$,調理表食品名$)':PRINT M:INPUT ZZ$
  145. 1230 IF M=-1 THEN 1200
  146. 1235 'PRINT CVS(CHORISYOKUHINJURYO$)
  147. 1240 CHORISYOKUHINJURYO(M)=CVS(CHORISYOKUHINJURYO$)
  148. 1245 GOTO 1200
  149. 1250 KOSSW=1:GOSUB 520
  150. 1260 KOSSW=0:RETURN
  151. 2000 'X$=INKEY$:IF X$="" THEN 2000 ELSE PRINT HEX$(ASC(X$)):GOTO 2000 
  152. 2440 LOCATE 0,0
  153. 2445 PRINT "　　　                                 　     ";:LOCATE 0,0
  154. 2450 INPUT "　　　調理名   　     ",CHORIMEI$
  155. 2460 IF CHORIMEI$="END" THEN CLOSE:RUN "EIYOUKEI.BAS":END
  156. 2461 IF CHORIMEI$="" THEN 2440
  157. 2465 CHORIMEI$=CHORIMEI$+SPACE$(32-LEN(CHORIMEI$))
  158. 2470 RETURN
  159. 3000 '文字入力ルーチンノ
  160. 3010 *INKEY
  161. 3020 OINWX$=INWX$:INWX$=""
  162. 3030 *INK1 W$=INKEY$:IF W$="" THEN *INK1
  163. 3040   INWX$=INWX$+W$
  164. 3050   IF W$=CHR$(&H0D) THEN *INK3
  165. 3060 *INK2 W$=INKEY$:IF W$<>"" THEN INWX$=INWX$+W$:GOTO *INK2
  166. 3070 *INK3 X$=INWX$
  167. 3080 'IF X$="グラフ" THEN GOSUB *ESW:GOTO *INKEY
  168. 3090 IF X$="終了"+CHR$(&H0D) THEN CLOSE:RUN "EIYOUKEI.BAS"
  169. 3100 'IF X$="クリア" THEN GOSUB 3160:X$=CHR$(&H1B):GOTO *INKE
  170. 3110 'IF X$="保存" THEN GOSUB *HOZON:GOTO *INKEY
  171. 3120 *INKE RETURN
  172.